home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / pc_pad.arc / ALGEBRA.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-07-10  |  4.5 KB  |  139 lines
  1. 1  '****  ALGEBRA AND GEOMETRY PROGRAM
  2. 3  ON ERROR GOTO 800
  3. 5  CLEAR : KEY OFF : FALSE = 0 : TRUE = NOT FALSE
  4. 6  SCREEN 0 : WIDTH 80
  5. 7  '****  MONOCHROME SENSING ROUTINE
  6. 8  DEF SEG=&H40 : DISPLAY=PEEK(&H10)
  7. 9  IF (DISPLAY AND &H30) = &H30 THEN MONOCHROME = TRUE ELSE MONOCHROME = FALSE
  8. 10  SCREEN 0 : WIDTH 80
  9. 12  CLS : PRINT "ALGEBRA Graphics Program"
  10. 14  PRINT "    Steve VanArsdale"
  11. 16  PRINT "Mt.Prospect, Illinois  312-259-7224"
  12. 18  PRINT
  13. 20  PRINT "SELECT algebra function:"
  14. 30  PRINT "A ... for the SINE of X"
  15. 40  PRINT "B ... for the COSINE of X"
  16. 50  PRINT "C ... for the TANGENT of X"
  17. 51  PRINT "D ... for the SECANT of X"
  18. 52  PRINT "E ... for the COTANGENT of X"
  19. 53  PRINT "F ... for the COSECANT of X"
  20. 54  PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
  21. 55  PRINT "H ... for the SQUARE ROOT of X"
  22. 60  PRINT " > ";:CHOICE$=INPUT$(1)
  23. 70  IF CHOICE$ ="A" OR CHOICE$ = "a" THEN DEF FNFUNCTION(X)=SIN(X):FUNCTION$="SIN(X)":GOTO 110
  24. 80  IF CHOICE$ ="B" OR CHOICE$ = "b"  THEN DEF FNFUNCTION(X)=COS(X):FUNCTION$="COSINE(X)":GOTO 110
  25. 90  IF CHOICE$ ="C" OR CHOICE$ = "c" THEN DEF FNFUNCTION(X)=TAN(X):FUNCTION$="TANGENT(X)":GOTO 110
  26. 91  IF CHOICE$ ="D" OR CHOICE$ = "d" THEN DEF FNFUNCTION(X)=1/COS(X):FUNCTION$="SECANT(X)":GOTO 110
  27. 92  IF CHOICE$ ="E" OR CHOICE$ = "e" THEN DEF FNFUNCTION(X)=1/TAN(X):FUNCTION$="COTANGENT(X)":GOTO 110
  28. 93  IF CHOICE$ ="F" OR CHOICE$ = "f" THEN DEF FNFUNCTION(X)=1/SIN(X):FUNCTION$="COSECANT(X)":GOTO 110
  29. 94  IF CHOICE$ ="G" OR CHOICE$ = "g" THEN DEF FNFUNCTION(X)=LOG(X+SQR(X*X+1)):FUNCTION$="INVERSE HYPERBOLIC SINE(X)":GOTO 110
  30. 95  IF CHOICE$ ="H" OR CHOICE$ = "h" THEN DEF FNFUNCTION(X)=SQR(ABS(X)):FUNCTION$="SQ.RT(X)":GOTO 110
  31. 100  GOTO 10
  32. 110  PRINT "DEPTH OF ";FUNCTION$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
  33. 115  IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 110
  34. 120  CLS:SCREEN 0 :WIDTH 80
  35. 155  '**** ACTIVATION OF COLOR/GRAPHICS MONITOR IF AVAILABLE ****
  36. 160  IF MONOCHROME = TRUE THEN WIDTH 80: DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20 : SCREEN 0 : WIDTH 80
  37. 170  SCREEN 0 :WIDTH 80
  38. 190  KEY(10) ON : ON KEY(10) GOSUB 800 : KEY(10) STOP
  39. 200  '****   GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
  40. 205  CLS
  41. 210  SCREEN 1,0:COLOR 0,1
  42. 220  C=100:R=100
  43. 230  '** AXIS DRAWING ROUTINE
  44. 240  GOSUB 900
  45. 245  '** PLOTTING PARAMETERS DISPLAY
  46. 250  LOCATE 17,1:PRINT "GRAPH of:"
  47. 260  LOCATE 18,1:PRINT FUNCTION$
  48. 270  LOCATE 20,1:PRINT "  X     Y"
  49. 275  '** PLOTTING ROUTINE
  50. 277  X=0:Y=0:XX=-1:YY=FNFUNCTION(XX):PSET(100,100)
  51. 278  RANDOMIZE 1000 : PLAY "MBO2T200L64MS"
  52. 280  FOR X = -1 TO 7 STEP 0.1
  53. 282  NOTE=INT(RND*83+1)
  54. 285  PLAY "N="+VARPTR$(NOTE)
  55. 290  LOCATE 21,1:PRINT USING "##.##";X
  56. 295  KEY(10) ON : KEY(10) STOP
  57. 300  Y = FNFUNCTION(X)
  58. 302  YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMIT < 0 THEN GOTO 390
  59. 305  ON ERROR GOTO 1000
  60. 310  LOCATE 21,7:PRINT USING "##.##";Y
  61. 320  PSET(20*X+100,100-30*Y),2
  62. 330  IF DEPTH <> 0 THEN LINE (20*X+101,99-30*Y)-(20*X+100+DEPTH,100-30*Y-DEPTH),1
  63. 350  LINE (20*XX+100,100-30*YY)-(20*X+100,100-30*Y),2
  64. 360  IF DEPTH <> 0 THEN LINE (20*XX+100+DEPTH,100-30*YY-DEPTH)-(20*X+100+DEPTH,100-30*Y-DEPTH),2
  65. 390  XX=X:YY=Y
  66. 400  NEXT X
  67. 405  GOSUB 900
  68. 410  LOCATE 25,1: PRINT "ENTER  X  TO EXIT";:VALUE$=INPUT$(1)
  69. 415  IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 10 ELSE CLS : KEY(10) ON
  70. 420  '****  SPECIAL EXIT DISPLAY ****
  71. 425  '** AXIS DRAWING SUBROUTINE
  72. 427  GOSUB 900
  73. 430  '** PLANE GRID DRAWING ROUTINE
  74. 431  FOR X = 10 TO R-10 STEP 10
  75. 432  LINE (C+X,R-X)-(105+C+X,R-X),1
  76. 433  LINE (C+X,R-X)-(C+X,0),1
  77. 434  LINE (C,R-X)-(195-X,5),1
  78. 435  LINE (C+X,R)-(195+X,5),1
  79. 436  NEXT X
  80. 438  LOCATE 1,22:PRINT " Z axis"
  81. 440  '** HOOP ROUTINE
  82. 450  CIRCLE (160,90),50,2,,,1
  83. 460  FOR I = 1 TO 20
  84. 470  CIRCLE STEP (1,-1),50,2,,,1
  85. 480  NEXT I
  86. 490  CIRCLE (160,90),50,0,,,1
  87. 500  '** ELLIPTICAL TUBE ROUTINE
  88. 505  CIRCLE (155,90),25,1,,,0.5
  89. 510  FOR I = 1 TO 35
  90. 520  CIRCLE STEP (1,1),25,1,,,0.5
  91. 530  NEXT I
  92. 540  CIRCLE STEP (1,1),25,0,,,0.5
  93. 550  CIRCLE (155,90),25,0,0,3.14,0.5
  94. 560  FOR I = 1 TO 20
  95. 570  CIRCLE STEP (1,-1),24,1,,,0.5
  96. 580  NEXT I
  97. 590  CIRCLE (155,90),25,2,0,3.14,0.5
  98. 600  '***  CONE ROUTINE
  99. 605  CIRCLE (45,55),38,3,,,1
  100. 610  FOR I = 1 TO 38
  101. 620  CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
  102. 630  NEXT I
  103. 640  CIRCLE (45,55),38,0,,,1
  104. 650  '**  GLOBE ROUTINE
  105. 655  CIRCLE (245,170),1,2,,,3
  106. 660  FOR I = 1 TO 10 STEP 1
  107. 670  CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
  108. 680  NEXT I
  109. 690  FOR I = 10 TO 0 STEP -1
  110. 700  CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
  111. 710  NEXT I
  112. 715  LINE -(245,170),3
  113. 720  '** PYRAMID ROUTINE
  114. 740  DRAW "BM10,150;C1;E30;F30;L60"
  115. 745  DRAW "BM+30,-28;D13"
  116. 750  LINE (40,135)-(11,149),1
  117. 760  LINE (40,135)-(69,149),1
  118. 770  '** CUBE ROUTINE
  119. 775  DRAW "BM265,85;C3;U30;R30;D30;L30"
  120. 780  DRAW "BM+20,-20;C3;U30;R30;D30;L30"
  121. 790  DRAW "C3;G20;BM+30,0;E20;BM+0,-30;G20;BM-30,0;E20"
  122. 799  LOCATE 25,1: PRINT "BYE.";
  123. 800  '**** TERMINATION LOGIC
  124. 805  IF MONOCHROME = TRUE THEN WIDTH 40: DEF SEG=0: A=PEEK(&H410): POKE &H410,A OR &H30 : SCREEN 0 : WIDTH 80 ELSE FOR I = 1 TO 2000 : NEXT I
  125. 840  CLS: PRINT "ALGEBRA Program Terminated."
  126. 845  END
  127. 900  '****  AXIS DRAWING SUBROUTINE ****
  128. 920  '****  AXIS DRAWING SUBROUTINE ****
  129. 921  LINE (C,0)-(C,199)
  130. 922  LINE (90,110)-(200,0)
  131. 924  LINE (0,R)-(319,R)
  132. 925  LOCATE 13,1:PRINT "X axis"
  133. 926  LOCATE 2,10:PRINT "Y axis"
  134. 927  LOCATE 1,22:PRINT " Z axis"
  135. 930  RETURN
  136. 1000  '****  CALCULATION ERROR HANDLER
  137. 1010  RESUME 390
  138. 1210  CLS : PRINT "ALGEBRA Graphics Program"
  139.